home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / MISC / MAG10.ZIP / CFONT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-14  |  1.8 KB  |  72 lines
  1. Unit CFont;
  2.  
  3. { Version 1.0 }
  4. { Developed by Spellcaster }
  5. { This unit provides suport for a 16x16 colorfont... This unit enables to   }
  6. { read a font from a file (with just a four bytes header that states the    }
  7. { X and Y size of the font, altough that is ignored... The rest of the file }
  8. { is raw data of all the characters (or just some characters) from code 32  }
  9. { (blank space) to code 122 (the char 'z')...                               }
  10. { All the theory behind this unit was explained in the Graphics article of  }
  11. { issue 9 of 'The Mag', in the Colorfonts section...                        }
  12. { The only diference is that this unit uses pointers to save base memory... }
  13.  
  14. Interface
  15.  
  16. Type CChar=Array[1..16,1..16] Of Byte;
  17.      CChars=Array[' '..'ยบ'] Of CChar;
  18.  
  19. Var Font:^CChars;
  20.     CFontX,CFontY:Integer;
  21.     CFontSize:Word;
  22.  
  23. Procedure LoadFont(Filename:String);
  24. Procedure PutLetter(X,Y:Integer;N:Char;Where:Word);
  25. Procedure PutString(X,Y:integer;N:string;Where:Word);
  26. Procedure KillFont;
  27.  
  28. Implementation
  29.  
  30. Uses Mode13h;
  31.  
  32. Procedure LoadFont(Filename:String);
  33. Var F:File;
  34. Begin
  35.      CFontSize:=SizeOf(Font^);
  36.      GetMem(Font,CFontSize);
  37.      Assign(F,Filename);
  38.      Reset(F,1);
  39.      BlockRead(F,CFontX,2);
  40.      BlockRead(F,CFontY,2);
  41.      BlockRead(F,Font^,FileSize(f)-4);
  42.      Close(F);
  43. End;
  44.  
  45. Procedure PutLetter(X,Y:Integer;N:Char;Where:Word);
  46. Var Cfx,Cfy:Byte;
  47. Begin
  48.      For Cfy:=1 To 16 Do
  49.      Begin
  50.           For Cfx:=1 To 16 Do
  51.           Begin
  52.                PutPixel(X+Cfx-1,Y+Cfy-1,Font^[N,Cfy,Cfx],Where);
  53.           End;
  54.      End;
  55. End;
  56.  
  57. Procedure PutString(X,Y:Integer;N:String;Where:Word);
  58. Var Index:Byte;
  59. Begin
  60.      For Index:=0 To Length(N)-1 Do
  61.      Begin
  62.           PutLetter(X+Index*16,Y,N[Index+1],Where);
  63.      End;
  64. End;
  65.  
  66. Procedure KillFont;
  67. Begin
  68.      FreeMem(Font,CFontSize);
  69. End;
  70.  
  71. Begin
  72. End.